MODULE textutil
  !-----------------------------------------------------------
  ! KRUUNUNHAKA basis set tool kit - text utilities
  !-----------------------------------------------------------
  ! See CHANGELOG
  !-----------------------------------------------------------
  ! Copyright (C) 2003-2008 Pekka Manninen, 2010 Jussi Lehtola
  !
  ! This program is distributed under the terms of the GNU General
  ! Public License as published by the Free Software Foundation;
  ! either version 2 of the License, or (at your option) any later version.
  !
  ! This program is distributed in the hope that it will be useful,
  ! but WITHOUT ANY WARRANTY; without even the implied warranty of
  ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 
  !
  ! Please note that this program as well as its 
  ! author must be properly cited whenever the program or some parts 
  ! originated on it are employed. 
  !
  !-----------------------------------------------------------
  USE definitions
  IMPLICIT NONE
CONTAINS
!-----------------------------------------------------------
  ! Calculate length of string
  FUNCTION str_arr_len(in) RESULT(len)
    IMPLICIT NONE
    CHARACTER, DIMENSION(:), INTENT(IN) :: in
    INTEGER :: len

    DO len=1,SIZE(in)
       IF (in(len)==' ') THEN
          EXIT
       END IF
    END DO
  END FUNCTION str_arr_len
!-----------------------------------------------------------
  ! Convert string from upper case to lower case
  FUNCTION str_up_to_lo(in) RESULT(out)
    IMPLICIT NONE
    CHARACTER(len=*), INTENT(IN) :: in
    CHARACTER(len=len(in)) :: out

    INTEGER :: i

    DO i=1,len(in)
       IF(in(i:i) >= "A" .AND. in(i:i) <= "Z") THEN
          out(i:i)= ACHAR(IACHAR(in(i:i))+32)
       ELSE
          out(i:i)=in(i:i)
       END IF
    END DO
  END FUNCTION str_up_to_lo
!-----------------------------------------------------------
  ! Convert string from upper case to lower case
  FUNCTION str_lo_to_up(in) RESULT(out)
    IMPLICIT NONE
    CHARACTER(len=*), INTENT(IN) :: in
    CHARACTER(len=len(in)) :: out
    INTEGER :: i

    DO i=1,len(in)
       IF(in(i:i) >= "a" .AND. in(i:i) <= "z") THEN
          out(i:i)= ACHAR(IACHAR(in(i:i))-32)
       ELSE
          out(i:i)=in(i:i)
       END IF
    END DO
  END FUNCTION str_lo_to_up
!-----------------------------------------------------------
  ! Print vertical bar with character c
  SUBROUTINE print_vertbar(c)
    IMPLICIT NONE
    CHARACTER, INTENT(IN) :: c
    CHARACTER(LEN=TERMWIDTH) :: tmp
    INTEGER :: i
    DO i= 1, TERMWIDTH
       tmp(i:i)=c
    END DO
    WRITE(*,'(A)') tmp
  END SUBROUTINE print_vertbar
!-----------------------------------------------------------
  ! Center-print string in a bar filled with c
  SUBROUTINE print_centerbar(str,c)
    IMPLICIT NONE
    CHARACTER(LEN=*), INTENT(IN) :: str
    CHARACTER, INTENT(IN) :: c
    ! Helper arrays
    CHARACTER(LEN=TERMWIDTH) :: trstr
    CHARACTER(LEN=TERMWIDTH) :: line
    INTEGER :: i,j
    INTEGER :: llen, strlen, rlen

    trstr=str
    strlen=LEN(str)
    rlen=(TERMWIDTH-strlen-2)/2
    llen=TERMWIDTH-strlen-2-rlen

    j=0
    DO i=1,llen
       j=j+1
       line(j:j)=c
    END DO

    j=llen+1
    line(j:j)=' '

    DO i=1,strlen
       j=j+1
       line(j:j)=trstr(i:i)
    END DO

    j=j+1
    line(j:j)=' '

    DO i=1,rlen
       j=j+1
       line(j:j)=c
    END DO

    WRITE(*,'(A)') line
  END SUBROUTINE print_centerbar
!-----------------------------------------------------------
  ! Center-print string, with lhs and rhs characters c
  SUBROUTINE print_center(str,c)
    IMPLICIT NONE
    CHARACTER(LEN=*), INTENT(IN) :: str
    CHARACTER, INTENT(IN) :: c
    ! Helper arrays
    INTEGER :: strlen, llen, rlen
    CHARACTER(LEN=MAXLEN) :: left, middle, right

    strlen=LEN(TRIM(str))
    rlen=(TERMWIDTH-strlen)/2
    llen=TERMWIDTH-strlen-rlen

    left=' '
    left(1:1)=c

    middle=TRIM(str)

    right=' '
    right(rlen:rlen)=c

    WRITE(*,'(A,A,A)') left(1:llen),middle(1:strlen),right(1:rlen)
  END SUBROUTINE print_center
!-----------------------------------------------------------
  ! Read a floating-point number from stdin
  FUNCTION read_double(question) RESULT(answer)
    IMPLICIT NONE
    CHARACTER(LEN=*), INTENT(IN) :: question
    REAL(KIND=prec) :: answer

    INTEGER :: stat

    stat = 1
    DO WHILE(stat /= 0)
       WRITE (*,'(A,A)',advance='no') TRIM(question),'> '
       READ (*,*,iostat=stat) answer
       WRITE (*,*) ''

       IF(stat /= 0) THEN
          WRITE (*,'(A)') 'Not a valid floating-point number.'
       END IF
    END DO
  END FUNCTION read_double
!-----------------------------------------------------------
  ! Read limits
  SUBROUTINE read_limits(question,low,high)
    IMPLICIT NONE
    CHARACTER(LEN=*), INTENT(IN) :: question
    REAL(KIND=prec), INTENT(OUT) :: low, high
    INTEGER :: stat

    stat = 1
    DO WHILE(stat /=0)
       WRITE (*,'(A,A)',advance='no') TRIM(question),'> '
       READ (*,*,iostat=stat) low,high
       WRITE (*,*) ''

       IF(stat /= 0) THEN
          WRITE (*,'(A)') 'Not a valid floating-point number.'
       END IF
    END DO
  END SUBROUTINE read_limits
!-----------------------------------------------------------
  ! Read integer
  FUNCTION read_int(question) RESULT(answer)
    IMPLICIT NONE
    CHARACTER(LEN=*), INTENT(IN) :: question
    INTEGER :: answer
    INTEGER :: stat

    stat = 1
    DO WHILE(stat /=0)
       WRITE (*,'(A,A)',advance='no') TRIM(question),'> '
       READ (*,*,iostat=stat) answer
       WRITE (*,*) ''

       IF(stat /= 0) THEN
          WRITE (*,'(A)') 'Not a valid integer.'
       END IF
    END DO
  END FUNCTION read_int
!-----------------------------------------------------------
  ! Read file name
  FUNCTION read_fname(question) RESULT(answer)
    IMPLICIT NONE
    CHARACTER(LEN=*), INTENT(IN) :: question
    CHARACTER(LEN=TERMWIDTH) :: answer
    INTEGER :: stat

    answer = ' '
    stat = 1
    DO WHILE(stat /=0 .OR. LEN(TRIM(answer))==0)
       WRITE (*,'(A,A)',advance='no') TRIM(question),'> '
       READ (*,*,iostat=stat) answer
       WRITE (*,*) ''

       IF(stat /= 0 .OR. LEN(TRIM(answer))==0) THEN
          WRITE (*,'(A)') 'Not a valid file name.'
       END IF
    END DO
  END FUNCTION read_fname
!-----------------------------------------------------------
END MODULE textutil
